home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Text / Emacs-1.12d folder / lisp / mac / mouse.el < prev    next >
Encoding:
Text File  |  1993-12-26  |  2.5 KB  |  78 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; This file is part of a Macintosh port of GNU Emacs.
  3. ;;; Copyright (C) 1993 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; Mouse support.  These are straight from x-mouse.el.
  6. ;;;
  7.  
  8. (defun x-mouse-select (arg)
  9.   "Select Emacs window the mouse is on."
  10.   (let ((start-w (selected-window))
  11.         (done nil)
  12.         (w (selected-window))
  13.         (rel-coordinate nil))
  14.     (while (and (not done)
  15.                 (null (setq rel-coordinate
  16.                             (coordinates-in-window-p arg w))))
  17.       (setq w (next-window w))
  18.       (if (eq w start-w)
  19.           (setq done t)))
  20.     (select-window w)
  21.     rel-coordinate))
  22.  
  23. (defun x-mouse-set-point (arg)
  24.   "Select Emacs window mouse is on, and move point to mouse position."
  25.   (let* ((relative-coordinate (x-mouse-select arg))
  26.          margin-column
  27.          (rel-x (car relative-coordinate))
  28.          (rel-y (car (cdr relative-coordinate))))
  29.     (if relative-coordinate
  30.         (let ((prompt-width (if (eq (selected-window) (minibuffer-window))
  31.                                 minibuffer-prompt-width 0)))
  32.           (move-to-window-line rel-y)
  33.           (if (eobp)
  34.               ;; If text ends before the desired line,
  35.               ;; always position at end of that line.
  36.               nil
  37.             (setq margin-column
  38.                   (if (or truncate-lines (> (window-hscroll) 0))
  39.                       (current-column)
  40.                     ;; If we are using line continuation,
  41.                     ;; compensate if first character on a continuation line
  42.                     ;; does not start precisely at the margin.
  43.                     (- (current-column)
  44.                        (% (current-column) (1- (window-width))))))
  45.             (move-to-column (+ rel-x (1- (max 1 (window-hscroll)))
  46.                                (if (= (point) 1)
  47.                                    (- prompt-width) 0)
  48.                                margin-column)))))))
  49.  
  50. (defun x-mouse-set-mark (arg)
  51.   "Select Emacs window mouse is on, and set mark at mouse position.
  52. Display cursor at that position for a second."
  53.   (if (x-mouse-select arg)
  54.       (let ((point-save (point)))
  55.         (unwind-protect
  56.             (progn (x-mouse-set-point arg)
  57.                    (push-mark nil t)
  58.                    (sit-for 1))
  59.           (goto-char point-save)))))
  60.  
  61.  
  62. ;;; This was originally hand-coded in C.  I wonder why.
  63. (defun coordinates-in-window-p (positions window)
  64.   "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
  65. Returned value is list of positions expressed\n\
  66. relative to window upper left corner."
  67.   (let* ((xcoord (nth 0 positions))
  68.          (ycoord (nth 1 positions))
  69.          (edges (window-edges window))
  70.          (left (nth 0 edges))
  71.          (top (nth 1 edges))
  72.          (right (nth 2 edges))
  73.          (bottom (nth 3 edges)))
  74.     (if (or (< xcoord left) (>= xcoord (1- right))
  75.             (< ycoord top) (>= ycoord (1- bottom)))
  76.         nil
  77.       (list (- xcoord left) (- ycoord top)))))
  78.